{2:}{4:}{$C-,A+,D-}{[$C+,D+]}
{:4}program TANGLE(webfile,changefile,Pascalfile,pool);label 9999;
const{8:}
	bufsize=100;
	maxbytes=45000;
	maxtoks=50000;
	maxnames=4000;
	maxtexts=2000;
	hashsize=353;
	longestname=400;
	linelength=72;
	outbufsize=144;
	stacksize=50;
	maxidlength=12;
	unambiglength=7;
{:8}
type{11:}
	ASCIIcode=0..255;{:11}{12:}
	textfile=packed file of char;
{:12}{37:}eightbits=0..255;sixteenbits=0..65535;
{:37}{39:}namepointer=0..maxnames;{:39}{43:}textpointer=0..maxtexts;
{:43}{78:}outputstate=record endfield:sixteenbits;bytefield:sixteenbits;
namefield:namepointer;replfield:textpointer;modfield:0..12287;end;
{:78}var{9:}history:0..3;{:9}{13:}xord:array[char]of ASCIIcode;
xchr:array[ASCIIcode]of char;{:13}{20:}termout:textfile;
{:20}{23:}webfile:textfile;changefile:textfile;
{:23}{25:}Pascalfile:textfile;pool:textfile;
{:25}
{27:}buffer:array[0..bufsize] of ASCIIcode;{:27}
{29:}phaseone:boolean;
{:29}{38:}bytemem:packed array[0..1,0..maxbytes]of ASCIIcode;
tokmem:packed array[0..2,0..maxtoks]of eightbits;
bytestart:array[0..maxnames]of sixteenbits;
tokstart:array[0..maxtexts]of sixteenbits;
link:array[0..maxnames]of sixteenbits;
ilk:array[0..maxnames]of sixteenbits;
equiv:array[0..maxnames]of sixteenbits;
textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer;
stringptr:namepointer;byteptr:array[0..1]of 0..maxbytes;
poolchecksum:integer;{:40}{44:}textptr:textpointer;
tokptr:array[0..2]of 0..maxtoks;z:0..2;
{maxtokptr:array[0..2]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize;
idloc:0..bufsize;doublechars:0..bufsize;
hash,chophash:array[0..hashsize]of sixteenbits;
choppedid:array[0..unambiglength]of ASCIIcode;
{:50}{65:}modtext:array[0..longestname]of ASCIIcode;
{:65}{70:}lastunnamed:textpointer;{:70}{79:}curstate:outputstate;
stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;
{:79}{80:}zo:0..2;{:80}{82:}bracelevel:eightbits;
{:82}{86:}curval:integer;
{:86}{94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize;
breakptr:0..outbufsize;semiptr:0..outbufsize;
{:94}{95:}outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode;
lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode;
{:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer;
limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean;
{:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode;
changelimit:0..bufsize;{:126}{143:}curmodule:namepointer;
scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;
{:156}{164:}currepltext:textpointer;{:164}{171:}modulecount:0..12287;
{:171}{179:}{troubleshooting:boolean;ddt:integer;dd:integer;
debugcycle:integer;debugskipped:integer;termin:textfile;}
{:179}{185:}{wo:0..1;}{:185}{30:}{procedure debughelp;forward;}
{:30}
{31:}
procedure error;
var
	j:0..outbufsize;
	k,l:0..bufsize;
begin
	if phaseone then{32:}
	begin
		if changing then
			write(termout, '. (change file ')
		else
			write(termout,'. (');
		writeln(termout,'l.',line:1,')');
		if loc>=limit then
			l:=limit
		else
			l:=loc;
		for k:=1 to l do
			if buffer[k-1]=9 then
				write(termout,' ')
			else
				write(termout,xchr[buffer[k-1]]);
		writeln(termout);
		for k:=1 to l do
			write(termout,' ');
		for k:=l+1 to limit do
			write(termout,xchr[buffer[k-1]]);
		write(termout,' ');
	end{:32}
	else{33:}
	begin
		writeln(termout,'. (l.',line:1,')');
		for j:=1 to outptr do
			write(termout,xchr[outbuf[j-1]]);
		write(termout,'... ');
	end{:33};
	break(termout);
	history:=2;
{debugskipped:=debugcycle;debughelp;}
end;{:31}

{34:}
procedure jumpout;
begin goto 9999;end;{:34}

procedure initialize;
var{16:}
	i:0..255;
{:16}{41:}
	wi:0..1;{:41}{45:}
	zi:0..2;{:45}{51:}
	h:0..hashsize;
{:51}
begin{10:}
	history:=0;{:10}{14:}
	xchr[32]:=' ';xchr[33]:='!';
xchr[34]:='"';xchr[35]:='#';xchr[36]:='$';xchr[37]:='%';xchr[38]:='&';
xchr[39]:='''';xchr[40]:='(';xchr[41]:=')';xchr[42]:='*';xchr[43]:='+';
xchr[44]:=',';xchr[45]:='-';xchr[46]:='.';xchr[47]:='/';xchr[48]:='0';
xchr[49]:='1';xchr[50]:='2';xchr[51]:='3';xchr[52]:='4';xchr[53]:='5';
xchr[54]:='6';xchr[55]:='7';xchr[56]:='8';xchr[57]:='9';xchr[58]:=':';
xchr[59]:=';';xchr[60]:='<';xchr[61]:='=';xchr[62]:='>';xchr[63]:='?';
xchr[64]:='@';xchr[65]:='A';xchr[66]:='B';xchr[67]:='C';xchr[68]:='D';
xchr[69]:='E';xchr[70]:='F';xchr[71]:='G';xchr[72]:='H';xchr[73]:='I';
xchr[74]:='J';xchr[75]:='K';xchr[76]:='L';xchr[77]:='M';xchr[78]:='N';
xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R';xchr[83]:='S';
xchr[84]:='T';xchr[85]:='U';xchr[86]:='V';xchr[87]:='W';xchr[88]:='X';
xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\';xchr[93]:=']';
xchr[94]:='^';xchr[95]:='_';xchr[96]:='`';xchr[97]:='a';xchr[98]:='b';
xchr[99]:='c';xchr[100]:='d';xchr[101]:='e';xchr[102]:='f';
xchr[103]:='g';xchr[104]:='h';xchr[105]:='i';xchr[106]:='j';
xchr[107]:='k';xchr[108]:='l';xchr[109]:='m';xchr[110]:='n';
xchr[111]:='o';xchr[112]:='p';xchr[113]:='q';xchr[114]:='r';
xchr[115]:='s';xchr[116]:='t';xchr[117]:='u';xchr[118]:='v';
xchr[119]:='w';xchr[120]:='x';xchr[121]:='y';xchr[122]:='z';
xchr[123]:='{';xchr[124]:='|';xchr[125]:='}';xchr[126]:='~';
xchr[0]:=' ';xchr[127]:=' ';{:14}{17:}
	for i:=1 to 31 do xchr[i]:=' ';
	for i:=128 to 255 do xchr[i]:=' ';
{:17}{18:}
	for i:=0 to 255 do xord[chr(i)]:=32;
	for i:=1 to 255 do xord[xchr[i]]:=i;
	xord[' ']:=32;
{:18}{21:}
	rewrite(termout,'TTY:');{:21}{26:}
	rewrite(Pascalfile);
	rewrite(pool);{:26}{42:}
	for wi:=0 to 1 do
	begin
		bytestart[wi]:=0;
		byteptr[wi]:=0;
	end;
	bytestart[2]:=0;
	nameptr:=1;
	stringptr:=256;
	poolchecksum:=271828;{:42}{46:}
	for zi:=0 to 2 do
	begin
		tokstart[zi]:=0;
		tokptr[zi]:=0;
	end;
	tokstart[3]:=0;
	textptr:=1;
	z:=1 mod 3;
{:46}{48:}
	ilk[0]:=0;
	equiv[0]:=0;
{:48}{52:}
	for h:=0 to hashsize-1 do
	begin
		hash[h]:=0;
		chophash[h]:=0;
	end;
{:52}{71:}
	lastunnamed:=0;
	textlink[0]:=0;{:71}{144:}
	scanninghex:=false;
{:144}{152:}
	modtext[0]:=32;
{:152}{180:}{troubleshooting:=true;
debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;
reset(termin,'TTY:','/I');}{:180}
end;{:2}

{24:}
procedure openinput;
begin
	reset(webfile);
	reset(changefile);
end;
{:24}

{28:}
function inputln(var f:textfile):boolean;
var
	finallimit:0..bufsize;
begin
	limit:=0;
	finallimit:=0;
	if eof(f)then
		inputln:=false
	else
	begin
		while not eoln(f) do
		begin
			buffer[limit]:=xord[f^];
			get(f);
			limit:=limit+1;
			if buffer[limit-1]<>32 then
				finallimit:=limit;
			if limit=bufsize then
			begin
				while not eoln(f) do
					get(f);
				limit:=limit-1;
				if finallimit>limit then
					finallimit:=limit;
				begin
					writeln(termout);
					write(termout,'! Input line too long');
				end;
				loc:=0;
				error;
			end;
		end;
		readln(f);
		limit:=finallimit;
		inputln:=true;
	end;
end;
{:28}

{49:}
procedure printid(p:namepointer);
var
	k:0..maxbytes;
	w:0..1;
begin
	if p>=nameptr then
		write(termout,'IMPOSSIBLE')
	else
	begin
		w:=p mod 2;
		for k:=bytestart[p] to bytestart[p+2]-1 do
			write(termout,xchr[bytemem[w,k]]);
	end;
end;{:49}

{53:}
function idlookup(t:eightbits):namepointer;
label 31,32;
var
	c:eightbits;
	i:0..bufsize;
	h:0..hashsize;
	k:0..maxbytes;
	w:0..1;
	l:0..bufsize;
	p,q:namepointer;
	s:0..unambiglength;
begin
	l:=idloc-idfirst;{54:}
	h:=buffer[idfirst];
	i:=idfirst+1;
	while i<idloc do
	begin
		h:=(h+h+buffer[i]) mod hashsize;
		i:=i+1;
	end{:54};
{55:}
	p:=hash[h];
	while p<>0 do
	begin
		if bytestart[p+2]-bytestart[p]=l then{56:}
		begin
			i:= idfirst;
			k:=bytestart[p];
			w:=p mod 2;
			while(i<idloc)and(buffer[i]=bytemem[w,k])do
			begin
				i:=i+1;
				k:=k+1;
			end;
			if i=idloc then
				goto 31;
		end{:56};
		p:=link[p];
	end;
	p:=nameptr;
	link[p]:=hash[h];
	hash[h]:=p;31:{:55};
	if(p=nameptr)or(t<>0)then{57:}
	begin
		if((p<>nameptr)and(t<>0)and(ilk[p]=0))
			or((p=nameptr)and(t=0)and(buffer[idfirst]<>34))then{58:}
		begin
			i:= idfirst;
			s:=0;
			h:=0;
			while(i<idloc)and(s<unambiglength)do
			begin
				if buffer[i]<>95 then
				begin
					if buffer[i]>=97 then
						choppedid[s]:=buffer[i]-32
					else
						choppedid[s]:= buffer[i];
					h:=(h+h+choppedid[s])mod hashsize;
					s:=s+1;
				end;
				i:=i+1;
			end;
			choppedid[s]:=0;
		end{:58};
		if p<>nameptr then{59:}
		begin
			if ilk[p]=0 then
			begin
				if t=1 then
				begin
					writeln(termout);
					write(termout,'! This identifier has already appeared');error;
				end;
				{60:}
				q:=chophash[h];
				if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:=
equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(termout);
write(termout,'! This identifier was defined before');error;end;
ilk[p]:=t;
end{:59}else{61:}begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=
chophash[h];while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;
w:=q mod 2;
while(k<bytestart[q+2])and(s<unambiglength)do begin c:=bytemem[w,k];
if c<>95 then begin if c>=97 then c:=c-32;
if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end;
if(k=bytestart[q+2])and(choppedid[s]<>0)then goto 32;
begin writeln(termout);write(termout,'! Identifier conflict with ');end;
for k:=bytestart[q]to bytestart[q+2]-1 do write(termout,xchr[bytemem[w,k
]]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h];
chophash[h]:=p;end{:62};w:=nameptr mod 2;k:=byteptr[w];
if k+l>maxbytes then begin writeln(termout);
write(termout,'! Sorry, ','byte memory',' capacity exceeded');error;
history:=3;jumpout;end;
if nameptr>maxnames-2 then begin writeln(termout);
write(termout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
jumpout;end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i];
k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+2]:=k;
nameptr:=nameptr+1;
if buffer[idfirst]<>34 then ilk[p]:=t else{64:}begin ilk[p]:=1;
if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin
equiv[p]:=stringptr+32768;l:=l-doublechars-1;
if l>99 then begin writeln(termout);
write(termout,'! Preprocessed string is too long');error;end;
stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]);
poolchecksum:=poolchecksum+poolchecksum+l;
while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]);
poolchecksum:=poolchecksum+poolchecksum+buffer[i];
while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end;
writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;
{:53}

{66:}
function modlookup(l:sixteenbits):namepointer;label 31;
var c:0..4;j:0..longestname;k:0..maxbytes;w:0..1;p:namepointer;
q:namepointer;begin c:=2;q:=0;p:=ilk[0];
while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 2;c:=1;j:=1;
while(k<bytestart[p+2])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
k+1;j:=j+1;end;
if k=bytestart[p+2]then if j>l then c:=1 else c:=4 else if j>l then c:=3
else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p;
if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;
{67:}w:=nameptr mod 2;k:=byteptr[w];
if k+l>maxbytes then begin writeln(termout);
write(termout,'! Sorry, ','byte memory',' capacity exceeded');error;
history:=3;jumpout;end;
if nameptr>maxnames-2 then begin writeln(termout);
write(termout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0;
ilk[p]:=0;c:=1;equiv[p]:=0;
for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l;
bytestart[nameptr+2]:=k+l;nameptr:=nameptr+1;{:67};
31:if c<>1 then begin begin writeln(termout);
write(termout,'! Incompatible section names');error;end;p:=0;end;
modlookup:=p;end;
{:66}

{69:}
function prefixlookup(l:sixteenbits):namepointer;var c:0..4;
count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..1;p:namepointer;
q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0;
while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 2;c:=1;j:=1;
while(k<bytestart[p+2])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
k+1;j:=j+1;end;
if k=bytestart[p+2]then if j>l then c:=1 else c:=4 else if j>l then c:=3
else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};
if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p;
count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end;
end;if count<>1 then if count=0 then begin writeln(termout);
write(termout,'! Name does not match');error;
end else begin writeln(termout);write(termout,'! Ambiguous prefix');
error;end;prefixlookup:=r;end;
{:69}{73:}procedure storetwobytes(x:sixteenbits);
begin if tokptr[z]+2>maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=x div 256;
tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;
{:73}{74:}{procedure printrepl(p:textpointer);var k:0..maxtoks;
a:sixteenbits;zp:0..2;
begin if p>=textptr then write(termout,'BAD')else begin k:=tokstart[p];
zp:=p mod 3;while k<tokstart[p+3]do begin a:=tokmem[zp,k];
if a>=128 then[75:]begin k:=k+1;
if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a);
if bytemem[a mod 2,bytestart[a]]=34 then write(termout,'"')else write(
termout,' ');end else if a<208 then begin write(termout,'@<');
printid((a-168)*256+tokmem[zp,k]);write(termout,'@>');
end else begin a:=(a-208)*256+tokmem[zp,k];
write(termout,'@',xchr[123],a:1,'@',xchr[125]);end;
end[:75]else[76:]case a of 9:write(termout,'@',xchr[123]);
10:write(termout,'@',xchr[125]);12:write(termout,'@''');
13:write(termout,'@"');125:write(termout,'@$');0:write(termout,'#');
64:write(termout,'@@');2:write(termout,'@=');3:write(termout,'@\');
others:write(termout,xchr[a])end[:76];k:=k+1;end;end;end;}
{:74}{84:}procedure pushlevel(p:namepointer);
begin if stackptr=stacksize then begin writeln(termout);
write(termout,'! Sorry, ','stack',' capacity exceeded');error;
history:=3;jumpout;end else begin stack[stackptr]:=curstate;
stackptr:=stackptr+1;curstate.namefield:=p;curstate.replfield:=equiv[p];
zo:=curstate.replfield mod 3;
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+3];curstate.modfield:=0;
end;end;{:84}{85:}procedure poplevel;label 10;
begin if textlink[curstate.replfield]=0 then begin if ilk[curstate.
namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1;
z:=textptr mod 3;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z];
}tokptr[z]:=tokstart[textptr];
{byteptr[nameptr mod 2]:=byteptr[nameptr mod 2]-1;}end{:91};
end else if textlink[curstate.replfield]<maxtexts then begin curstate.
replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 3;
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+3];goto 10;end;
stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr];
zo:=curstate.replfield mod 3;end;10:end;
{:85}

{87:}
function getoutput:sixteenbits;label 20,30,31;
var a:sixteenbits;b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..1;
begin 20:if stackptr=0 then begin a:=0;goto 31;end;
if curstate.bytefield=curstate.endfield then begin curval:=-curstate.
modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end;
a:=tokmem[zo,curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
if a<128 then if a=0 then{92:}begin pushlevel(nameptr-1);goto 20;
end{:92}else goto 31;a:=(a-128)*256+tokmem[zo,curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
if a<10240 then{89:}begin case ilk[a]of 0:begin curval:=a;a:=130;end;
1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20;
end;
3:begin{90:}while(curstate.bytefield=curstate.endfield)and(stackptr>0)do
poplevel;
if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin
writeln(termout);write(termout,'! No parameter given for ');end;
printid(a);error;goto 20;end;{93:}bal:=1;
curstate.bytefield:=curstate.bytefield+1;
while true do begin b:=tokmem[zo,curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin
begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
end;b:=tokmem[zo,curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
end else case b of 40:bal:=bal+1;41:begin bal:=bal-1;
if bal=0 then goto 30;end;
39:repeat begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
end;b:=tokmem[zo,curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;until b=39;others:end;
begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
end;end;end;30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;
w:=nameptr mod 2;k:=byteptr[w];
{if k=maxbytes then begin writeln(termout);
write(termout,'! Sorry, ','byte memory',' capacity exceeded');error;
history:=3;jumpout;end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;}
if nameptr>maxnames-2 then begin writeln(termout);
write(termout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
jumpout;end;bytestart[nameptr+2]:=k;nameptr:=nameptr+1;
if textptr>maxtexts-3 then begin writeln(termout);
write(termout,'! Sorry, ','text',' capacity exceeded');error;history:=3;
jumpout;end;textlink[textptr]:=0;tokstart[textptr+3]:=tokptr[z];
textptr:=textptr+1;z:=textptr mod 3{:90};pushlevel(a);goto 20;end;
others:begin writeln(termout);
write(termout,'! This can''t happen (','output',')');error;history:=3;
jumpout;end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240;
if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln(
termout);write(termout,'! Not present: <');end;printid(a);
write(termout,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129;
curstate.modfield:=curval;31:{if troubleshooting then debughelp;}
getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize;
b:0..outbufsize;begin b:=breakptr;
if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr;
for k:=1 to breakptr do write(Pascalfile,xchr[outbuf[k-1]]);
writeln(Pascalfile);line:=line+1;
if line mod 100=0 then begin write(termout,'.');
if line mod 500=0 then write(termout,line:1);break(termout);end;
if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr
:=breakptr+1;if breakptr>b then b:=breakptr;end;
for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end;
outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0;
if outptr>linelength then begin begin writeln(termout);
write(termout,'! Long line must be truncated');error;end;
outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer);
var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10;
v:=v div 10;k:=k-1;until v=0;repeat k:=k+1;
begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end;
until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits;
v:sixteenbits);label 20;var k:0..linelength;
begin{102:}20:case outstate of 1:if t<>3 then begin breakptr:=outptr;
if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;
2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end;
if outptr>linelength then flushbuffer;breakptr:=outptr;end;
3,4:begin{103:}if(outval<0)or((outval=0)and(lastsign<0))then begin
outbuf[outptr]:=45;outptr:=outptr+1;
end else if outsign>0 then begin outbuf[outptr]:=outsign;
outptr:=outptr+1;end;appval(abs(outval));
if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2;
goto 20;end;
5:{104:}begin if(t=3)or({105:}((t=2)and(v=3)and(((outcontrib[1]=68)and(
outcontrib[2]=73)and(outcontrib[3]=86))or((outcontrib[1]=77)and(
outcontrib[2]=79)and(outcontrib[3]=68))))or((t=0)and((v=42)or(v=47)))
{:105})then begin{103:}if(outval<0)or((outval=0)and(lastsign<0))then
begin outbuf[outptr]:=45;outptr:=outptr+1;
end else if outsign>0 then begin outbuf[outptr]:=outsign;
outptr:=outptr+1;end;appval(abs(outval));
if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp;
end else outval:=outval+outapp;outstate:=3;goto 20;end{:104};
0:if t<>3 then breakptr:=outptr;others:end{:102};
if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k];
outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end;
if outptr>linelength then flushbuffer;
if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr;
end;if t>=2 then outstate:=1 else outstate:=0 end;
{:101}{106:}procedure sendsign(v:integer);
begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v;
outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end;
others:begin breakptr:=outptr;outapp:=v;outstate:=2;end end;
lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer);
label 666,10;
begin case outstate of 1:begin{110:}if(outptr=breakptr+3)or((outptr=
breakptr+4)and(outbuf[breakptr]=32))then if((outbuf[outptr-3]=68)and(
outbuf[outptr-2]=73)and(outbuf[outptr-1]=86))or((outbuf[outptr-3]=77)and
(outbuf[outptr-2]=79)and(outbuf[outptr-1]=68))then goto 666{:110};
outsign:=32;outstate:=3;outval:=v;breakptr:=outptr;lastsign:=+1;end;
0:begin{109:}if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[
breakptr]=47))then goto 666{:109};outsign:=0;outstate:=3;outval:=v;
breakptr:=outptr;lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;
outval:=outapp*v;end;3:begin outstate:=5;outapp:=v;
begin writeln(termout);
write(termout,'! Two numbers occurred without a sign between them');
error;end;end;4:begin outstate:=5;outapp:=outapp*v;end;
5:begin outval:=outval+outapp;outapp:=v;begin writeln(termout);
write(termout,'! Two numbers occurred without a sign between them');
error;end;end;{:108}others:goto 666 end;goto 10;
666:{111:}if v>=0 then begin if outstate=1 then begin breakptr:=outptr;
begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v);
if outptr>linelength then flushbuffer;outstate:=1;
end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end;
begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v);
begin outbuf[outptr]:=41;outptr:=outptr+1;end;
if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end;
{:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits;
k:0..linelength;j:0..maxbytes;w:0..1;n:integer;
begin while stackptr>0 do begin curchar:=getoutput;
21:case curchar of 0:;
{116:}65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,
87,88,89,90:begin outcontrib[1]:=curchar;sendout(2,1);end;
97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar-32;
sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 2;
while(k<maxidlength)and(j<bytestart[curval+2])do begin k:=k+1;
outcontrib[k]:=bytemem[w,j];j:=j+1;
if outcontrib[k]>=97 then outcontrib[k]:=outcontrib[k]-32 else if
outcontrib[k]=95 then k:=k-1;end;sendout(2,k);end;
{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0;
repeat curchar:=curchar-48;if n>=214748364 then begin writeln(termout);
write(termout,'! Constant too big');error;end else n:=10*n+curchar;
curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0;
if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21;
end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48;
repeat curchar:=curchar-48;if n>=268435456 then begin writeln(termout);
write(termout,'! Constant too big');error;end else n:=8*n+curchar;
curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21;
end;13:begin n:=0;curchar:=48;
repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48;
if n>=134217728 then begin writeln(termout);
write(termout,'! Constant too big');error;end else n:=16*n+curchar;
curchar:=getoutput;
until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65));
sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1;
outcontrib[1]:=46;curchar:=getoutput;
if curchar=46 then begin outcontrib[2]:=46;sendout(1,2);
end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0
,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);
{114:}4:begin outcontrib[1]:=65;outcontrib[2]:=78;outcontrib[3]:=68;
sendout(2,3);end;5:begin outcontrib[1]:=78;outcontrib[2]:=79;
outcontrib[3]:=84;sendout(2,3);end;6:begin outcontrib[1]:=73;
outcontrib[2]:=78;sendout(2,2);end;31:begin outcontrib[1]:=79;
outcontrib[2]:=82;sendout(2,2);end;24:begin outcontrib[1]:=58;
outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60;
outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60;
outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62;
outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61;
outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46;
outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1;
outcontrib[1]:=39;repeat if k<linelength then k:=k+1;
outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0);
if k=linelength then begin writeln(termout);
write(termout,'! String too long');error;end;sendout(1,k);
curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117};
{115:}33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,
95,96,123,124{:115}:sendout(0,curchar);
{121:}9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91);
bracelevel:=bracelevel+1;end;
10:if bracelevel>0 then begin bracelevel:=bracelevel-1;
if bracelevel=0 then sendout(0,125)else sendout(0,93);
end else begin writeln(termout);write(termout,'! Extra @}');error;end;
129:begin k:=2;
if bracelevel=0 then outcontrib[1]:=123 else outcontrib[1]:=91;
if curval<0 then begin outcontrib[k]:=58;curval:=-curval;k:=k+1;end;
n:=10;while curval>=n do n:=10*n;repeat n:=n div 10;
outcontrib[k]:=48+(curval div n);curval:=curval mod n;k:=k+1;until n=1;
if outcontrib[2]<>58 then begin outcontrib[k]:=58;k:=k+1;end;
if bracelevel=0 then outcontrib[k]:=125 else outcontrib[k]:=93;
sendout(1,k);end;{:121}127:begin sendout(3,0);outstate:=6;end;
2:{118:}begin k:=0;repeat if k<linelength then k:=k+1;
outcontrib[k]:=getoutput;until(outcontrib[k]=2)or(stackptr=0);
if k=linelength then begin writeln(termout);
write(termout,'! Verbatim string too long');error;end;sendout(1,k-1);
end{:118};3:{122:}begin sendout(1,0);
while outptr>0 do begin if outptr<=linelength then breakptr:=outptr;
flushbuffer;end;outstate:=0;end{:122};others:begin writeln(termout);
write(termout,'! Can''t output ASCII code ',curchar:1);error;end end;
goto 22;2:{120:}repeat if k<linelength then k:=k+1;
outcontrib[k]:=curchar;curchar:=getoutput;
if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k<
linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput;
end else if curchar=101 then curchar:=69;
until(curchar<>69)and((curchar<48)or(curchar>57));
if k=linelength then begin writeln(termout);
write(termout,'! Fraction too long');error;end;sendout(3,k);
goto 21{:120};22:end;end;{:113}{127:}function linesdontmatch:boolean;
label 10;var k:0..bufsize;begin linesdontmatch:=true;
if changelimit<>limit then goto 10;
if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then
goto 10;linesdontmatch:=false;10:end;
{:127}{128:}

procedure primethechangebuffer;
label 22,30,10;
var
	k:0..bufsize;
begin
	changelimit:=0;
{129:}
	while true do
	begin
		line:=line+1;
		if not inputln(changefile)then
			goto 10;
		if limit<2 then
			goto 22;
		if buffer[0]<>64 then goto 22;
		if(buffer[1]>=88)and(buffer[1]<=90)then
			buffer[1]:=buffer[1]+32;
		if buffer[1]=120 then goto 30;
		if(buffer[1]=121)or(buffer[1]=122)then
		begin
			loc:=2;
			begin
				writeln(termout);
				write(termout,'! Where is the matching @x?');
				error;
			end;
		end;
22:
	end;

30:{:129};{130:} { @x has been found }
	repeat
		line:=line+1;
		if not inputln(changefile)then
		begin
			begin
				writeln(termout);
				write(termout,'! Change file ended after @x');
				error;
			end;
			goto 10;
		end;
	until limit>0;{:130};{131:}
	begin
		changelimit:=limit;
		if limit>0 then
			for k:=0 to limit-1 do
				changebuffer[k]:=buffer[k];
	end{:131};
10:
end;{:128}

{132:}
procedure checkchange;label 10;
var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0;
while true do begin changing:=not changing;templine:=otherline;
otherline:=line;line:=templine;line:=line+1;
if not inputln(changefile)then begin begin writeln(termout);
write(termout,'! Change file ended before @y');error;end;changelimit:=0;
changing:=not changing;templine:=otherline;otherline:=line;
line:=templine;goto 10;end;
{133:}if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(
buffer[1]<=90)then buffer[1]:=buffer[1]+32;
if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2;
begin writeln(termout);write(termout,'! Where is the matching @y?');
error;end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2;
begin writeln(termout);
write(termout,'! Hmm... ',n:1,' of the preceding lines failed to match')
;error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit;
if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
end{:131};changing:=not changing;templine:=otherline;otherline:=line;
line:=templine;line:=line+1;
if not inputln(webfile)then begin begin writeln(termout);
write(termout,'! WEB file ended during a change');error;end;
inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end;
10:end;{:132}

{135:}
procedure getline;
label 20;
begin
20:
	if changing then{137:}
	begin
		line:=line+1;
		if not inputln(changefile) then
		begin
			begin
				writeln(termout);
				write(termout,'! Change file ended without @z');
				error;
			end;
			buffer[0]:=64;
			buffer[1]:=122;
			limit:=2;
		end;
		if limit>1 then
			if buffer[0]=64 then
			begin
				if(buffer[1]>=88)and(buffer[1]<=90)then
					buffer[1]:=buffer[1]+32;
				if(buffer[1]=120)or(buffer[1]=121)then
				begin
					loc:=2;
					begin
						writeln(termout);
						write(termout,'! Where is the matching @z?');
						error;
					end;
				end
				else
				if buffer[1]=122 then
				begin
					primethechangebuffer;
					changing:=not changing;
					templine:=otherline;
					otherline:=line;
					line:=templine;
				end;
			end;
	end{:137};
	if not changing then
	begin{136:}
		begin
			line:=line+1;
			if not inputln(webfile)then
				inputhasended:=true
			else if limit= changelimit then
				if buffer[0]=changebuffer[0]then
					if changelimit>0 then
						checkchange;
		end{:136};
		if changing then goto 20;
	end;
	loc:=0;
	buffer[limit]:=32;
end;
{:135}

{139:}
function controlcode(c:ASCIIcode):eightbits;
begin
	case c of
		64:controlcode:=64;
		39:controlcode:=12;
		34:controlcode:=13;
		36:controlcode:=125;
		32,9:controlcode:=136;
		42:
		begin
			write(termout,'*',modulecount+1:1);
			break(termout);
			controlcode:=136;
		end;
		68,100:controlcode:=133;
		70,102:controlcode:=132;
		123:controlcode:=9;
		125:controlcode:=10;
		80,112:controlcode:=134;
		84,116,94,46,58:controlcode:=131;
		38:controlcode:=127;
		60:controlcode:=135;
		61:controlcode:=2;
		92:controlcode:=3;
		others:controlcode:=0
	end;
end;{:139}

{140:}
function skipahead:eightbits;
label 30;
var
	c:eightbits;
begin
	while true do
	begin
		if loc > limit then
		begin
			getline;
			if inputhasended then
			begin
				c:=136;
				goto 30;
			end;
		end;
		buffer[limit+1]:=64;
		while buffer[loc]<>64 do
			loc:=loc+1;
		if loc<=limit then
		begin
			loc:=loc+2;
			c:=controlcode(buffer[loc-1]);
			if(c<>0)or(buffer[loc-1]=62)then
				goto 30;
		end;
	end;
30:
	skipahead:=c;
end;{:140}

{141:}
procedure skipcomment;
label 10;
var bal:eightbits;c:ASCIIcode;begin bal:=0;
while true do begin if loc>limit then begin getline;
if inputhasended then begin begin writeln(termout);
write(termout,'! Input ended in mid-comment');error;end;goto 10;end;end;
c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc];
if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else
begin begin writeln(termout);
write(termout,'! Section ended in mid-comment');error;end;loc:=loc-1;
goto 10;
end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123
then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10;
bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits;
label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname;
begin 20:if loc>limit then begin getline;
if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc];
loc:=loc+1;
if scanninghex then{146:}if((c>=48)and(c<=57))or((c>=65)and(c<=70))then
goto 31 else scanninghex:=false{:146};
case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
,112,113,114,115,116,117,118,119,120,121,122:{148:}begin if((c=101)or(c=
69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[loc-2]>=48)then c:=0;
if c<>0 then begin loc:=loc-1;idfirst:=loc;repeat loc:=loc+1;
d:=buffer[loc];
until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95);
if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69;
end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1;
repeat d:=buffer[loc];loc:=loc+1;
if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0;
doublechars:=doublechars+1;
end else begin if d=64 then begin writeln(termout);
write(termout,'! Double @ sign missing');error;
end end else if loc>limit then begin begin writeln(termout);
write(termout,'! String constant didn''t end');error;end;d:=34;end;
until d=34;idloc:=loc-1;c:=130;end{:149};
64:{150:}begin c:=controlcode(buffer[loc]);loc:=loc+1;
if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135
then{151:}begin{153:}k:=0;
while true do begin if loc>limit then begin getline;
if inputhasended then begin begin writeln(termout);
write(termout,'! Input ended in section name');error;end;goto 30;end;
end;d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1];
if d=62 then begin loc:=loc+2;goto 30;end;
if(d=32)or(d=9)or(d=42)then begin begin writeln(termout);
write(termout,'! Section name didn''t end');error;end;goto 30;end;
k:=k+1;modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1;
if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32;
if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;
30:{155:}if k>=longestname-2 then begin begin writeln(termout);
write(termout,'! Section name too long: ');end;
for j:=1 to 25 do write(termout,xchr[modtext[j]]);write(termout,'...');
if history=0 then history:=1;end{:155};
if(modtext[k]=32)and(k>0)then k:=k-1;{:153};
if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]=
46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k);
end else curmodule:=modlookup(k);
end{:151}else if c=131 then begin repeat c:=skipahead;until c<>64;
if buffer[loc-1]<>62 then begin writeln(termout);
write(termout,'! Improper @ within control text');error;end;goto 20;end;
end{:150};
{147:}46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32;
loc:=loc+1;end;
end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93;
loc:=loc+1;end;end;
58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24;
loc:=loc+1;end;end;
61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30;
loc:=loc+1;end;end;
62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29;
loc:=loc+1;end;end;
60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28;
loc:=loc+1;end;
end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26;
loc:=loc+1;end;end;
40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9;
loc:=loc+1;end;
end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91;
loc:=loc+1;end;end;
42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10;
loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end;
125:begin begin writeln(termout);write(termout,'! Extra }');error;end;
goto 20;end;others:if c>=128 then goto 20 else end;
31:{if troubleshooting then debughelp;}getnext:=c;end;
{:145}{157:}procedure scannumeric(p:namepointer);label 21,30;
var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer;
begin{158:}accumulator:=0;nextsign:=+1;
while true do begin nextcontrol:=getnext;
21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0;
repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext;
until(nextcontrol>57)or(nextcontrol<48){:160};
begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21;
end;12:begin{161:}val:=0;nextcontrol:=48;
repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext;
until(nextcontrol>55)or(nextcontrol<48){:161};
begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21;
end;13:begin{162:}val:=0;nextcontrol:=48;
repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7;
val:=16*val+nextcontrol-48;nextcontrol:=getnext;
until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and(
nextcontrol<65)){:162};begin accumulator:=accumulator+nextsign*(val);
nextsign:=+1;end;goto 21;end;130:begin q:=idlookup(0);
if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end;
begin accumulator:=accumulator+nextsign*(equiv[q]-32768);nextsign:=+1;
end;end;43:;45:nextsign:=-nextsign;132,133,135,134,136:goto 30;
59:begin writeln(termout);
write(termout,'! Omit semicolon in numeric definition');error;end;
others:{159:}begin begin writeln(termout);
write(termout,'! Improper numeric definition will be flushed');error;
end;repeat nextcontrol:=skipahead until(nextcontrol>=132);
if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end;
accumulator:=0;goto 30;end{:159}end;end;30:{:158};
if abs(accumulator)>=32768 then begin begin writeln(termout);
write(termout,'! Value too big: ',accumulator:1);error;end;
accumulator:=0;end;equiv[p]:=accumulator+32768;end;
{:157}{165:}procedure scanrepl(t:eightbits);label 22,30,31,21;
var a:sixteenbits;b:ASCIIcode;bal:eightbits;begin bal:=0;
while true do begin 22:a:=getnext;case a of 40:bal:=bal+1;
41:if bal=0 then begin writeln(termout);write(termout,'! Extra )');
error;end else bal:=bal-1;39:{168:}begin b:=39;
while true do begin begin if tokptr[z]=maxtoks then begin writeln(
termout);write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
end;if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(
termout);write(termout,'! You should double @ signs in strings');error;
end;if loc=limit then begin begin writeln(termout);
write(termout,'! String didn''t end');error;end;buffer[loc]:=39;
buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1;
if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1
;begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;
end;end;end;end;31:end{:168};35:if t=3 then a:=0;
{167:}130:begin a:=idlookup(0);
begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=(a div 256)+128;
tokptr[z]:=tokptr[z]+1;end;a:=a mod 256;end;
135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then
begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168;
tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;
2:{169:}begin begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;
end;buffer[limit+1]:=64;
21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64
then begin begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;
end;loc:=loc+2;goto 21;end;
end else begin begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=buffer[loc];
tokptr[z]:=tokptr[z]+1;end;loc:=loc+1;goto 21;end;
if loc>=limit then begin writeln(termout);
write(termout,'! Verbatim string didn''t end');error;
end else if buffer[loc+1]<>62 then begin writeln(termout);
write(termout,'! You should double @ signs in verbatim strings');error;
end;loc:=loc+2;end{:169};
133,132,134:if t<>135 then goto 30 else begin begin writeln(termout);
write(termout,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text');
error;end;goto 22;end;136:goto 30;{:167}others:end;
begin if tokptr[z]=maxtoks then begin writeln(termout);
write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;
end;end;30:nextcontrol:=a;
{166:}if bal>0 then begin if bal=1 then begin writeln(termout);
write(termout,'! Missing )');error;end else begin writeln(termout);
write(termout,'! Missing ',bal:1,' )''s');error;end;
while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln(
termout);write(termout,'! Sorry, ','token',' capacity exceeded');error;
history:=3;jumpout;end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1;
end;bal:=bal-1;end;end{:166};
if textptr>maxtexts-3 then begin writeln(termout);
write(termout,'! Sorry, ','text',' capacity exceeded');error;history:=3;
jumpout;end;currepltext:=textptr;tokstart[textptr+3]:=tokptr[z];
textptr:=textptr+1;if z=2 then z:=0 else z:=z+1;end;
{:165}{170:}procedure definemacro(t:eightbits);var p:namepointer;
begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext;
textlink[currepltext]:=0;end;{:170}

{172:}
procedure scanmodule;
label 22,30,10;
var
	p:namepointer;
begin
	modulecount:=modulecount+1;
	{173:}
	nextcontrol:=0;
	while true do
	begin
22:
		while nextcontrol<=132 do
		begin
			nextcontrol:= skipahead;
			if nextcontrol=135 then
			begin
				loc:=loc-2;
				nextcontrol:=getnext;
			end;
		end;
		if nextcontrol<>133 then
			goto 30;
		nextcontrol:=getnext;
		if nextcontrol<>130 then
		begin
			begin
				writeln(termout);
				write(termout,
					'! Definition flushed, must start with ',
					'identifier of length > 1');
				error;
			end;
			goto 22;
		end;
		nextcontrol:=getnext;
		if nextcontrol=61 then
		begin
			scannumeric(idlookup(1));
			goto 22;
		end
		else if nextcontrol=30 then
		begin
			definemacro(2);
			goto 22;
		end
		else{174:}if nextcontrol=40 then
		begin
			nextcontrol:=getnext;
			if nextcontrol=35 then
			begin
				nextcontrol:=getnext;
				if nextcontrol=41 then
				begin
					nextcontrol:=getnext;
					if nextcontrol=61 then
					begin
						begin
							writeln(termout);
							write(termout,'! Use == for macros');
							error;
						end;
						nextcontrol:=30;
					end;
					if nextcontrol=30 then
					begin
						definemacro(3);
						goto 22;
					end;
				end;
			end;
		end;
{:174};
		begin
			writeln(termout);
			write(termout,'! Definition flushed since it starts badly');
			error;
		end;
	end;
30:{:173};{175:}
	case nextcontrol of
	134:
		p:=0;
	135:
	begin
		p:=curmodule;
{176:}
		repeat
			nextcontrol:=getnext;
		until nextcontrol<>43;
		if(nextcontrol<>61)and(nextcontrol<>30)then
		begin
			begin
				writeln(termout);
				write(termout,'! Pascal text flushed, = sign is missing');
				error;
			end;
			repeat
				nextcontrol:=skipahead;
			until nextcontrol=136;
			goto 10;
		end{:176};
	end;
	others:
		goto 10
	end;{177:}
	storetwobytes(53248+modulecount);{:177};
	scanrepl(135);
{178:}
	if p=0 then
	begin
		textlink[lastunnamed]:=currepltext;
		lastunnamed:=currepltext;
	end
	else if equiv[p]=0 then
		equiv[p]:=currepltext
	else
	begin
		p:=equiv[p];
		while textlink[p]<maxtexts do
			p:=textlink[p];
		textlink[p]:=currepltext;
	end;
	textlink[currepltext]:=maxtexts;{:178};{:175};
10:
end;
{:172}

{181:}{
procedure debughelp;
label 888,10;
var k:integer;
begin
	debugskipped:=debugskipped+1;
	if debugskipped<debugcycle then
		goto 10;
	debugskipped:=0;
	while true do
	begin
		begin
			writeln(termout);
			write(termout,'#');
		end;
		break(termout);
		read(termin,ddt);
		if ddt<0 then goto 10
		else if ddt=0 then
		begin
			goto 888;
888:
			ddt:=0;
		end
		else
		begin
			read(termin,dd);
			case ddt of
			1: printid(dd);
			2: printrepl(dd);
			3: for k:=1 to dd do
				write(termout,xchr[buffer[k]]);
			4: for k:=1 to dd do
				write(termout,xchr[modtext[k]]);
			5: for k:=1 to outptr do
				write(termout,xchr[outbuf[k]]);
			6:for k:=1 to dd do
				write(termout,xchr[outcontrib[k]]);
			others: write(termout,'?')
			end;
		end;
	end;
10:
end;}
{:181}{182:}

begin
	initialize;{134:}
	openinput;
	line:=0;
	otherline:=0;
	changing:=true;
	primethechangebuffer;
	changing:=not changing;
	templine:=otherline;
	otherline:=line;
	line:=templine;
	limit:=0;
	loc:=1;
	buffer[0]:=32;
	inputhasended:=false;{:134};
	writeln(termout,'This is TANGLE, Version 4.5');{183:}
	phaseone:=true;
	modulecount:=0;
	repeat
		nextcontrol:=skipahead;
	until nextcontrol=136;
	while not inputhasended do
		scanmodule;
{138:}
	if changelimit<>0 then
	begin
		for ii:=0 to changelimit do
			buffer[ii]:=changebuffer[ii];
		limit:=changelimit;
		changing:=true;
		line:=otherline;
		loc:=changelimit;
		begin
			writeln(termout);
			write(termout,'! Change file entry did not match');
			error;
		end;
	end{:138};
	phaseone:=false;
{:183};{for ii:=0 to 2 do maxtokptr[ii]:=tokptr[ii];}
{112:}
	if textlink[0]=0 then
	begin
		begin
			writeln(termout);
			write(termout,'! No output was specified.');
		end;
		if history=0 then
			history:=1;
	end
	else
	begin
		begin
			writeln(termout);
			write(termout,'Writing the output file');
		end;
		break(termout);
{83:}
		stackptr:=1;
		bracelevel:=0;
		curstate.namefield:=0;
		curstate.replfield:=textlink[0];
		zo:=curstate.replfield mod 3;
		curstate.bytefield:=tokstart[curstate.replfield];
		curstate.endfield:=tokstart[curstate.replfield+3];
		curstate.modfield:=0;
{:83};{96:}
		outstate:=0;
		outptr:=0;
		breakptr:=0;
		semiptr:=0;
		outbuf[0]:=0;
		line:=1;{:96};
		sendtheoutput;{98:}
		breakptr:=outptr;
		semiptr:=0;
		flushbuffer;
		if bracelevel<>0 then
		begin
			writeln(termout);
			write(termout,'! Program ended at brace level ',bracelevel:1);
			error;
		end;
{:98};
		begin
			writeln(termout);
			write(termout,'Done.');
		end;
	end{:112};

9999:
	if stringptr>256 then{184:}
	begin
		begin
			writeln(termout);
			write(termout,stringptr-256:1,' strings written to string pool file.');
		end;
		write(pool,'*');
		for ii:=1 to 9 do
		begin
			outbuf[ii]:=poolchecksum mod 10;
			poolchecksum:=poolchecksum div 10;
		end;
		for ii:=9 downto 1 do
			write(pool,xchr[48+outbuf[ii]]);
		writeln(pool);
	end{:184};

{[186:]
	begin
		writeln(termout);
		write(termout,'Memory usage statistics:');
	end;
	begin
		writeln(termout);
		write(termout,nameptr:1,' names, ',textptr:1,' replacement texts;');
	end;
	begin
		writeln(termout);
		write(termout,byteptr[0]:1);
	end;
	for wo:=1 to 1 do
		write(termout,'+',byteptr[wo]:1);
	if phaseone then
		for ii:=0 to 2 do
			maxtokptr[ii]:=tokptr[ii];
	write(termout,' bytes, ',maxtokptr[0]:1);
	for ii:=1 to 2 do
		write(termout,'+',maxtokptr[ii]:1);
	write(termout,' tokens.');[:186];}
{187:}
	case history of
	0:
		begin
			writeln(termout);
			write(termout,'(No errors were found.)');
		end;
	1:
		begin
			writeln(termout);
			write(termout,'(Did you see the warning message above?)');
		end;
	2:
		begin
			writeln(termout);
			write(termout,'(Pardon me, but I think I spotted something wrong.)');
		end;
	3:
		begin
			writeln(termout);
			write(termout,'(That was a fatal error, my friend.)');
		end;
	end{:187};
end.{:182}
